perm filename LOSS.LSP[TIM,LSP]4 blob sn#715175 filedate 1983-06-14 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(grindef pairs)
C00005 ENDMK
CāŠ—;
(grindef pairs)


(DEFUN PAIRS (X Y MUST-APPEAR FUN APPLY-CONSTRAINTS CONSTRAINTS
	       NIL-PAIRS) 
   (METER:INC METER:SCCPP-COUNT-ARRAY 0 1)
   ((LAMBDA (XXX) 
      (PROGN
       (METER:INC METER:SCCPP-COUNT-ARRAY 1 1)
       (MAPCAN 
	#'(LAMBDA (I) 
	    (AND
	     (COND
	      (MUST-APPEAR
	       (PROGN
		(METER:INC METER:SCCPP-COUNT-ARRAY 2 1)
		(*CATCH
		 'OUT
		 (PROGN
		  (METER:INC METER:SCCPP-COUNT-ARRAY 3 1)
		  (MAPC 
		   #'(LAMBDA (I) 
		       (COND
			((PROGN
			  (METER:INC METER:SCCPP-COUNT-ARRAY 4 1)
			  (MEMBER 
			   (PROGN (METER:INC METER:SCCPP-COUNT-ARRAY
					     5
					     1)
				  (CDR I))
			   MUST-APPEAR))
			 (PROGN (METER:INC METER:SCCPP-COUNT-ARRAY
					   6
					   1)
				(*THROW 'OUT T)))))
		   I)))))
	      (T))
	     (PROGN (METER:INC METER:SCCPP-COUNT-ARRAY 7 1)
		    (LIST I))))
	XXX)))
    (PROGN
     (METER:INC METER:SCCPP-COUNT-ARRAY 8 1)
     (MAPCAR #'CDR
	     (COND
	      ((PROGN (METER:INC METER:SCCPP-COUNT-ARRAY 9 1)
		      (< (PROGN (METER:INC METER:SCCPP-COUNT-ARRAY
					   10
					   1)
				(LENGTH X))
			 (+ (COND (NIL-PAIRS 1) (T 0))
			    (PROGN (METER:INC METER:SCCPP-COUNT-ARRAY
					      10
					      1)
				   (LENGTH Y)))))
	       (PAIRS1 (MAKE-POSSIBILITY-1 X
					   Y
					   FUN
					   APPLY-CONSTRAINTS
					   CONSTRAINTS
					   NIL-PAIRS)))
	      (T (PAIRS2 (MAKE-POSSIBILITY-2 Y
					     X
					     FUN
					     APPLY-CONSTRAINTS
					     CONSTRAINTS
					     NIL-PAIRS))))))))
*